home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus Special 23
/
AMIGAplus Sonderheft 23 (2000)(Falke)(DE)[!].iso
/
Tools
/
Text-Viewer
/
Notes
/
deutsch
/
BassSchlüssel.file
< prev
next >
Wrap
Text File
|
1999-11-06
|
38KB
|
1,266 lines
/* Unterprogramm zu Noten.pprx */
signal on halt
signal on break_c
signal on break_e
signal on break_d
call ppm_SetStyle(N)
call ppm_SetMagMode(180)
call ppm_UpdateScreen()
noteneingabe:
/* Kleinster Notenabstand */
sysart = "Notensystemart:2"
systemart = ppm_Getform("Bitte noch einmal die gewählte Systemart eingeben. (2, 1v oder 1b)", 3, sysart)
select
when systemart == '2' then zdist = 4
when systemart == '1v' then zdist = 2
when systemart == '1b' then zdist = 2
otherwise noteneingabe()
end
zdist2 = zdist-2
xgrdform = "(1,2,4,8 oder 16)"
xgrd = ppm_GetForm("Bitte für den kleinsten Notenwert eingeben ...(nichts=ABBRUCH)", 3, xgrdform)
if xgrd == '' then exit_msg("Abbruch")
select
when xgrd == '1' then xg =0.7
when xgrd == '2' then xg =1.4
when xgrd == '4' then xg =2.8
when xgrd == '8' then xg =5.6
when xgrd == '16' then xg =11.2
otherwise noteneingabe()
end
/* Punktgröße der Noten */
notepkt = 26
call ppm_SetJustification(0)
zz = 0 /* Zeilenzähler */
notex = 2.5
page = ppm_CurrentPage()
pfad:
do
choose=ppm_Inform(2,"Auswahl des Notenfiles oder Abbruch ...", "Abbruch","File")
if choose == 0 then exit_msg("Abbruch")
eingabe = ppm_GetFileName("Bitte Notenscriptfile wählen ...", "Noten:")
res = OPEN(notenfile, eingabe, 'R')
if res == 0 then
do
call ppm_inform(1,"Fehler in der Eingabe, oder File existiert nicht !!!","OK")
pfad()
end
call ppm_ShowStatus("OK, ich arbeite ...")
auslesen(notenfile)
end
/* x-Abstände der Noten zueinander */
auslesen:
do
parse arg file
noten = READCH(file, 4000)
i=1
do forever
nw = word(noten, i)
nn = word(noten, i+1)
al = word(noten, i+2)
if nw == 'P' then nw = 'p'
if nw == 'D' then nw = 'd'
if nw == 'L' then nw = 'l'
if nw == 'T' then nw = 't'
if nn == 'T' then nn = 't'
if nw == 'J' then nw = 'j'
if nw == 'E' then nw = 'e'
select
when al == (X2C(410a)) then al = 'a'
when al == (X2C(610a)) then al = 'a'
when al == (X2C(300a)) then al = '0'
otherwise exit_msg("Da war ein Fehler!")
end
select
when nn=='DB1' then nn = 'Db1'
when nn=='EB1' then nn = 'Eb1'
when nn=='GB1' then nn = 'Gb1'
when nn=='AB1' then nn = 'Ab1'
when nn=='DB2' then nn = 'Db2'
when nn=='EB2' then nn = 'Eb2'
when nn=='GB2' then nn = 'Gb2'
when nn=='AB2' then nn = 'Ab2'
when nn=='DB3' then nn = 'Db3'
when nn=='EB3' then nn = 'Eb3'
when nn=='GB3' then nn = 'Gb3'
otherwise NOP
end
call auswahl()
i=i+3
end
end
auswahl:
do
select
when nw == 'j' then do
zz = 0 /* Zeilenzähler */
notex = 2.5
return
end
when nw == 'e' then
do
call ppm_ClearStatus()
exit_msg("Geschafft!")
end
when nw == 's' then
do
xw = xg/16
nw='x'
yv = 0
end
when nw == 'S' then
do
xw = xg/16
nw='X'
yv = 0.47
end
when nw == 'a' then
do
xw = xg/8
nw='e'
yv = 0
end
when nw == 'A' then
do
xw = xg/8
nw='E'
yv = 0.47
end
when nw == 'v' then
do
xw = xg/4
nw='q'
yv = 0
end
when nw == 'V' then
do
xw = xg/4
nw='Q'
yv = 0.47
end
when nw == 'h' then
do
xw = xg/2
yv = 0
end
when nw == 'H' then
do
xw = xg/2
yv = 0.47
end
when nw == 'g' then
do
xw = xg
nw='w'
yv = 0
end
when nw == 'G' then
do
xw = xg
nw='W'
yv = 0.47
end
when nw == 'pk' then
do
if notex < 3 then
do
notex = bakx
zz = zz - zdist
call ppm_SetSize(25)
box#id = ppm_CreateBox(notex+0.4, yw+zz+0.26-yv, 0.3, 0.9, 0)
call ppm_SetSize(20)
call ppm_TextIntoBox(box#id, 'd')
end
else
do
call ppm_SetSize(25)
box#id = ppm_CreateBox(notex-xw+0.4, yw+zz+0.26-yv, 0.3, 0.9, 0)
call ppm_SetSize(20)
call ppm_TextIntoBox(box#id, 'd')
end
select
when nn == '1' then
do
xw = xg
notex = notex+xw
end
when nn == '2' then
do
xw = xg/2
notex = notex+xw
end
when nn == '4' then
do
xw = xg/4
notex = notex+xw
end
when nn == '8' then
do
xw = xg/8
notex = notex+xw
end
when nn == '16' then
do
xw = xg/16
notex = notex+xw
end
when nn == 't' then
do
xw = 0.2
notex = notex+xw
end
otherwise
do
call ppm_ClearStatus()
exit_msg("Da war ein Fehler")
end
end
if notex >=18.7 then
do
notex = 2.5
zz = zz + zdist
end
return
end
when nw == 'PK' then
do
if notex < 3 then
do
notex = bakx
zz = zz - zdist
call ppm_SetSize(25)
box#id = ppm_CreateBox(notex+0.4, yw+zz+0.26-yv, 0.3, 0.9, 0)
call ppm_SetSize(20)
call ppm_TextIntoBox(box#id, 'd')
end
else
do
call ppm_SetSize(25)
box#id = ppm_CreateBox(notex-xw+0.4, yw+zz+0.26-yv, 0.3, 0.9, 0)
call ppm_SetSize(20)
call ppm_TextIntoBox(box#id, 'd')
end
select
when nn == '1' then
do
xw = xg
notex = notex+xw
end
when nn == '2' then
do
xw = xg/2
notex = notex+xw
end
when nn == '4' then
do
xw = xg/4
notex = notex+xw
end
when nn == '8' then
do
xw = xg/8
notex = notex+xw
end
when nn == '16' then
do
xw = xg/16
notex = notex+xw
end
when nn == 't' then
do
xw = 0.2
notex = notex+xw
end
otherwise
do
call ppm_ClearStatus()
exit_msg("Da war ein Fehler")
end
end
if notex >=18.7 then
do
notex = 2.5
zz = zz + zdist
end
return
end
/* Taktstrich */
when nw == 't' then
do
call ppm_SetLineWeight(0.25)
call ppm_DrawLine(notex, 2+zz+zdist2, notex, zdist2+2.8+zz)
